home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / DevTools / wordcache < prev   
Encoding:
Text File  |  1991-09-21  |  3.1 KB  |  199 lines
  1. \ Cache recently enterred words for quick retrieval.
  2. \ Only words longer then 3 characters are cached.
  3. \
  4. \ Wedge commands under F9 and F10 to complete a partially
  5. \ typed word if found in cache.
  6. \
  7. \ Author: Phil Burk
  8. \ Copyright 1988 Phil Burk
  9.  
  10. ANEW TASK-WORDCACHE
  11.  
  12. 128 constant WC_MAX_NFAS
  13.  
  14. wc_max_nfas array NFA-CACHE
  15.  
  16. create WC-PAD 34 allot
  17.  
  18. variable WC-START-I
  19. variable WC-COUNT
  20. variable WC-LAST-SPAN
  21. variable WC-AGAIN-OK
  22.  
  23. : WC.MATCH?  ( $part-name nfa -- match? , can this be part )
  24.     2dup c@ 31 and  ( length of word )
  25.     swap c@ ( -- $p nfa #nfa #$ ) >
  26.     IF
  27.         >r count r> 1+
  28.         text=?
  29.     ELSE 2drop false
  30.     THEN
  31. ;
  32.  
  33. : WC.SEARCH ( $part-name -- index true | 0 )
  34.     false swap  ( default flag )
  35.     wc_max_nfas wc-start-i @
  36.     DO    dup i nfa-cache @
  37.         wc.match?
  38.         IF
  39.             >r drop i true r>
  40.             LEAVE
  41.         THEN
  42.     LOOP
  43.     drop
  44. ;
  45.  
  46. : WC.ADD.NAME ( nfa -- , add or move to beginning )
  47.     0 nfa-cache @  ( nfa nfasafe )
  48.     wc_max_nfas 1
  49.     DO  \ move down until match
  50.         2dup =
  51.         IF LEAVE
  52.         THEN
  53.         i nfa-cache dup @ >r ( nfa nfaprev addr )
  54.         ! r>
  55.     LOOP
  56.     drop
  57.     0 nfa-cache !
  58. ;
  59.  
  60. defer wc.old.find
  61. what's find is wc.old.find
  62.  
  63. : WC.FIND ( $word -- cfa true | $word false )
  64.     wc.old.find
  65.     2dup
  66.     IF
  67.         >name dup c@ 31 and 3 >  ( add if more then 3 chars )
  68.         IF
  69.             wc.add.name
  70.         ELSE
  71.             drop
  72.         THEN
  73.     ELSE drop
  74.     THEN
  75.     wc-again-ok off
  76. ;
  77.  
  78. : WC.PRINT ( n -- )
  79.     >newline
  80.     wc_max_nfas min 0
  81.     DO i 4 .r 3 spaces
  82.         i nfa-cache @ id. ?pause cr
  83.     LOOP
  84. ;
  85.  
  86. variable wc-if-on
  87.  
  88. : WC.SCAN.BACK  ( -- index , of first char of last word )
  89. \ scan backwards for space, return index of char after
  90.     0
  91.     span @ 1
  92.     DO
  93.         span @ 1- i - kh-address @ + c@
  94.         BL =
  95.         IF drop span @ i - LEAVE
  96.         THEN
  97.     LOOP
  98. ;
  99.  
  100. : WC.SEARCH+INS
  101.     wc-pad wc.search
  102.     IF
  103.         dup 1+ wc-start-i !
  104.         nfa-cache @ count 31 and
  105.         wc-pad c@ - swap
  106.         wc-pad c@ + swap
  107.         dup wc-count !
  108.         text>expect
  109.         span @ wc-last-span !
  110.     ELSE
  111.         0 wc-count !
  112.         0 wc-start-i !
  113.     THEN
  114. ;
  115.  
  116. : WC.COMPLETE  ( -- , complete word where cursor is )
  117.     kh-cursor @ span @ =
  118.     IF
  119.         wc.scan.back dup>r
  120.         kh-address @ +  ( index addr )
  121.         span @ r> - ( addr count )
  122.         dup 32 <
  123.         IF
  124.             wc-pad off wc-pad $append
  125.             0 wc-start-i !
  126.             wc.search+ins
  127.         THEN
  128.         wc-again-ok on
  129.     ELSE ." Not at EOL!"
  130.     THEN
  131. ;
  132.  
  133. : (WC.TRY.AGAIN) ( -- , try a different completion )
  134.     span @ wc-last-span @  -
  135.     wc-count @ + dup 0<
  136.     IF
  137.         drop
  138.     ELSE
  139.         0
  140.         DO kh.backspace
  141.         LOOP
  142.         wc.search+ins
  143.     THEN
  144. ;
  145.  
  146. : WC.TRY.AGAIN ( -- )
  147.     wc-again-ok @
  148.     IF (wc.try.again)
  149.     THEN
  150. ;
  151.  
  152. : WORD.CACHE.ON
  153.     wc-if-on @ 0=
  154.     IF
  155.         what's find is wc.old.find
  156.         ' wc.find is find
  157.         ' wc.complete 9 fkey-vectors !
  158.         >newline ." <F9> to complete words." cr
  159.         ' wc.try.again 10 fkey-vectors !
  160.         ." <F10> to try another match." cr
  161. \
  162.         wc_max_nfas 0
  163.         DO
  164.             ' swap >name i nfa-cache !
  165.         LOOP
  166. \
  167.         wc-if-on on
  168.     THEN
  169. ;
  170.  
  171. : WORD.CACHE.OFF
  172.     wc-if-on @
  173.     IF
  174.         what's wc.old.find is find
  175.         ' noop 9 fkey-vectors !
  176.         ' noop 10 fkey-vectors !
  177.         wc-if-on off
  178.     THEN
  179. ;
  180.  
  181. : [FORGET]  ( -- , remove forgotten nfas )
  182.     [forget]
  183.     ' swap >name
  184.     wc_max_nfas 0
  185.     DO
  186.         i nfa-cache @ latest >
  187.         IF  dup i nfa-cache !
  188.         THEN
  189.     LOOP
  190.     drop
  191. ;
  192.  
  193. if.forgotten word.cache.off
  194.  
  195. : AUTO.INIT auto.init word.cache.on ;
  196. : AUTO.TERM word.cache.off auto.term ;
  197.  
  198. cr ." Enter:  WORD.CACHE.ON     to activate word cache!" cr
  199.